;;#################################################
;; toolbar2.lsp 
;; code to implement toolbar for workmap
;; Copyright (c) 1992-2002 by Forrest W. Young
;;#################################################

;; soft buttons


(defmeth toolbox-overlay-proto :change-num-tools-shown (num)
  (if num
      (send self :num-icons-shown (min num (send self :num-icons)))
      (send self :num-icons-shown (send self :num-icons)))
  (send self :redraw)
  )
        
  
(defmeth toolbox-overlay-proto :change-button-function (i &optional choice)
  (let* ((icon-list (copy-list (send self :icon-list)))
         (but-names (copy-list (send self :button-name-list)))
         (data-types-list (copy-list (send self :data-types-list)))
         (menu-item-list (send *vista* :remove-dash-menu-items *analyze-menu*))
         (icon-list-master (copy-list (send self :icon-list-master)))
         (but-name-master (send self :button-name-master))
         (data-types-master (copy-list (send *vista* :plugin-data-types)))
         (but (select icon-list-master i))
         (soft (send self :enable-soft-buttons))
         (title-list))
    (send self :enable-soft-buttons nil)
    (when (not choice)
          (setf title-list (copy-list (mapcar #'(lambda (menu-item)
                (remove-period (send menu-item :title)))
                                        menu-item-list)))
          (setf choice (choose-item-dialog "Choose an Analysis for this Button:" title-list)))
    (when choice
          (setf (select but-names  i) (select but-name-master choice))
          (setf (select data-types-list i) (select data-types-master choice))
          (setf (select icon-list i) (select icon-list-master choice))
          (send self :icon-list icon-list)
          (send self :button-name-list but-names)
          (send self :data-types-list data-types-list)
          (mapcar #'(lambda (but name )
                      (send but :title name))
                  icon-list but-names )
          (send self :soft-button-titles but-names))
    (send self :enable-soft-buttons soft)
    ))


(defmeth toolbox-overlay-proto :restore-toolbar ()
  (let* ((soft-button-titles (send self :soft-button-titles))
         (button-name-master (send self :button-name-master))
         (loc) (locations)
         (loopvals (iseq (length soft-button-titles)))
         (skipflag)
         )
    (setf locations 
          (mapcar #'(lambda (but-tit i)
                      (setf loc (position but-tit button-name-master 
                                          :test #'equal))
                      loc)
                  soft-button-titles loopvals))

    (mapcar #'(lambda (i loc)
                (cond 
                  (loc (send self :change-button-function i loc))
                  (t (send self :num-icons-shown 
                           (1- (send self :num-icons-shown)))
                     (send self :num-icons-shown 
                           (1- (send self :num-icons-shown)))
                     )))
            loopvals locations)))


;=========================

(defmeth toolbox-overlay-proto :set-all-num-buts-shown-variables ()
  (let* ((nsee (send self :num-icons-fit-in-window)) ;number can show right now
         (nmax (send self :num-icons))               ;max number defined to show
         (nshowable (send self :num-icons-shown))    ;max number permitted to show
         (nsee (send self :num-icons-fit-in-window)) ;limit imposd by current window size
         (nplugs *nplugins*)                         ;3 less than max icons defined
         )                   
    (setf *num-toolbar-buts-shown-at-startup* nshowable)    ;this is max permitted to show 
    (send *workmap* :num-toolbar-buts nmax)
    (list (+ 3 *nplugins*)
          *num-toolbar-buts-shown-at-startup* 
          (send *toolbox* :num-icons-fit-in-window))
    ))
          

(defmeth toolbox-overlay-proto :num-icons-fit-in-window ()
  (cond
   ((and *vista-exists*                                 ;fwy changed to *vista-exists* from
                                                        ;*vista-has-been-shown* 10-08-02
         (send self :graph) 
         (send (send self :graph) :has-slot 'showing)
         (send (send self :graph) :showing) )
    (let* ((graph (send self :graph))
           (toolbar-length (send graph :toolbar-length))
           (has-v-scroll (send graph :has-v-scroll))
           (unused-toolbar-space 
                (- (first (send graph :size)) 
                   toolbar-length 26                   ;fwy added 26 10-08-02
                   (if has-v-scroll 140 124)))
           (icon-space 52))                            ;fwy changed from 56 10-08-02
      (if (send graph :showing)
          (max 1 (ceiling (/ (+ toolbar-length unused-toolbar-space) icon-space)))
          1)))
    ((send self :graph) 
     (send (send self :graph) :num-toolbar-buts))
    (t 1)))

(defmeth toolbox-overlay-proto :append-tool (tool-object)
  (let ((num-buts-see-max 
         (min (send self :num-icons-fit-in-window)
              (send (send self :w) :num-toolbar-buts))))
    (send tool-object :x (+ (* (send self :num-icons) 52) 10))
    (send tool-object :y 5)
    (send self :num-icons (+ 1 (send self :num-icons)))
    (send self :num-icons-shown 
          (if num-buts-see-max (min (send self :num-icons) num-buts-see-max) 
              (send self :num-icons)))
    (send self :x (append (send self :x) (list (send tool-object :x))))
    (send self :y (append (send self :y) (list (send tool-object :y))))
    (send self :icon-list (append (send self :icon-list) (list tool-object)))
    (send self :ok-data-types (append (send self :ok-data-types)
                                      (last (send *vista* :plugin-data-types)))) 
    (send self :button-name-list (append (send self :button-name-list)
                                         (list (send tool-object :title))))  
    (send self :icon-list-master (append (send self :icon-list-master) 
                                        (list tool-object)))
    (send self :button-name-master (append (send self :button-name-master) 
                                          (list (send tool-object :title))))
    (send self :analyze-menu-item-name-master 
          (append (send self :analyze-menu-item-name-master)
                  (last (send *vista* :plugin-menu-item-titles))))
    (send self :data-types-master 
          (append (send self :data-types-master)
                  (last (send *vista* :plugin-data-types))))
    (send self :analysis-symbols-master 
         (append (send self :analysis-symbols-master)
                  (last (send *vista* :plugin-menu-item-titles))))
    (send (send self :graph) :redraw)
    ))


(defmeth toolbox-overlay-proto :update-buttons ()
  (when (send (send self :graph) :gui)
        (let* ((num-fit (send self :num-icons-fit-in-window))
              (num-shown (min num-fit (send self :num-icons-shown)))
              (icon-list  (select (send self :icon-list) (iseq num-shown))))
          (mapcar #'(lambda (icon)
                      (send icon :show-icon 
                            (send icon :state) :draw t))
                  icon-list))))


(defmeth toolbox-overlay-proto :draw-toolbar (&key (show t))
  (let* ((graph (send self :graph))
         (draw-color (send graph :draw-color))
         (back-color (send graph :back-color))
         (toolbar-length (send graph :toolbar-length))
         (has-v-scroll (send graph :has-v-scroll))
         (freeze-toolbar nil)
         (num-fit (send self :num-icons-fit-in-window))
         (logo-at-top)
         (n    (send self :num-icons))
         (num-shown (send self :num-icons-shown))
         (dummy (WHEN (< (SEND SELF :NUM-ICONS-SHOWN) 1)
                      (WHEN *VERBOSE* (PRINT "IN TOOLBAR.LSP DRAW-TOOLBAR: NO BUTTONS"))
                      (HIDE-TOOLBAR)(SHOW-TOOLBAR)))
         (DUMMY (when (> (first (send graph :size)) 
                         (+ toolbar-length (if has-v-scroll 140 124)))
                      (setf logo-at-top nil)))
         )
    (when (and (send graph :toolbar)
               (> (send self :num-icons-shown) 0)
               (not (send (send self :graph) :postpone-redraw))
               );*workmap*
          (let* ((text-h (+ (send graph :text-ascent) 
                            (send graph :text-descent)))
                 (unused-toolbar-space 
                  (- (first (send graph :size)) 
                     toolbar-length 
                     (if has-v-scroll 140 124)))
                 (icon-space 56)
                 (num-shown 
                  (cond
                    (freeze-toolbar num-shown)
                    ((< unused-toolbar-space 0) num-fit)
                    (t num-shown)))
                 (num-shown (max 3 (min num-fit num-shown (send self :num-icons-shown))))
                 (toolbar-length
                  (cond
                    (freeze-toolbar toolbar-length)
                    (t (- toolbar-length 
                          (* icon-space (- (send self :num-icons-shown)
                                           num-shown))))))
                 (logo-at-top (> (first (send graph :size)) 
                                 (+ toolbar-length (if has-v-scroll 140 124))))
                 
                 (unused-toolbar-space (- (first (send graph :size)) toolbar-length))
                 (icon-space 56)
                 (toolbar-length
                  (ceiling (/ (+ toolbar-length unused-toolbar-space) 
                                    icon-space)))
                 (logo-at-top nil)
                 (icon-list (select (send self :icon-list)
                                    (if (< num-shown 3) 3 (iseq num-shown))))
                       (x    (select (send self :x) (iseq num-shown)))
                 (y    (send self :y))
                       (scroll (send graph :scroll))
                 (scrollx (+ 90 (first scroll)));100
                 (scrolly (second scroll))
                       (icon nil)   
                 (bar-bottom (+ 20 text-h));32
                 (right-end (+ (first (last x)) 56))
                 (far-right-end right-end)
                 (vrx (first  (send graph :view-rect)))
                 (vry (second (send graph :view-rect)))
                 (w (third  (send graph :view-rect)))
                 (h (fourth (send graph :view-rect)))
                 (logo-width 125)
                 #+macintosh       (u 1)
                 #-macintosh       (u 0)
                 )
            (if (send *vista* :background-color)
                (send graph :draw-color 'toolbar-background)
                (send graph :draw-color 'white))
            (send graph :paint-rect 
                  (+ scrollx 2) (- scrolly u)
                  (- far-right-end 8) (+ bar-bottom 2))
            (send graph :back-color 'workmap-background);toolbar-background
            (send graph :draw-color 'tool-icon-color)
            (when (send graph :gui)
                  (mapcar #'(lambda (icon x y) 
                              (send icon :x (+ x scrollx))
                              (send icon :y (+ y -1 scrolly))
                              (send icon :show-icon 
                                          (send icon :state) :draw show))
                          icon-list x y))
            (send graph :draw-color 'black)
            
            (send graph :frame-rect
                  (+ scrollx 2) (- scrolly u) 
                  (- right-end 4) (+ bar-bottom 2))
            (send graph :frame-rect
                  (+ scrollx 4) (- (+ scrolly 2) u)
                  (- right-end 8) (- bar-bottom 2))
            ;next clause was commented out
            (when logo-at-top
                  (send graph :frame-rect
                        (+ scrollx 2) (- scrolly u) 
                        (- far-right-end 4) (+ bar-bottom 2))
                  (send graph :frame-rect
                        (+ scrollx right-end -1) (- (+ scrolly 2) u)
                        (- 130 8) (- bar-bottom 2)) )
            (send graph :draw-color 'toolbar-background)
            (send graph :paint-rect (+ scrollx right-end -2) scrolly w (+ 4 text-h))
            (send graph :line-width 2)
            (send graph :draw-color 'black)
            (send graph :draw-line (+ scrollx right-end -2) scrolly (+ vrx w) scrolly )
            (send graph :draw-line (+ scrollx right-end -2) (+ text-h scrolly 4) 
                  (+ vrx w) (+ text-h scrolly 4))
            (send graph :line-width 1)
            (send self :three-buttons 
                  (send self :draw-three-buttons)) 
            ))
    (send graph :back-color back-color)
    (send graph :draw-color draw-color)
    ))


(defmeth toolbox-overlay-proto :draw-buttons ()
  (let* ((graph (send self :graph))
         (num-fit (send self :num-icons-fit-in-window))
         (num-shown (min num-fit (send self :num-icons-shown)))
         (icon-list (select (send self :icon-list)) (iseq num-fit))
         (scroll (send graph :scroll))
         (scrollx (+ 90 (first scroll)));100
         (scrolly (second scroll))
         (x (select (+ (send self :x) scrollx)) (iseq num-fit))
         (y (select (+ (send self :y) scrolly)) (iseq num-fit))
         )
    (when (send graph :gui)
          (mapcar #'(lambda (icon x y) 
                      (send icon :x x)
                      (send icon :y (1- y))
                      (send icon :show-icon (send icon :state)))
                  icon-list x y)
          )))
